home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / Meter.tcl.z / Meter.tcl
Encoding:
Text File  |  1999-01-26  |  2.7 KB  |  125 lines
  1. # Meter.tcl --
  2. #
  3. #    Implements the tixMeter widget
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11.  
  12. tixWidgetClass tixMeter {
  13.     -classname TixMeter
  14.     -superclass tixPrimitive
  15.     -method {
  16.     }
  17.     -flag {
  18.     -foreground -text -value
  19.     }
  20.     -configspec {
  21.     {-fillcolor fillColor FillColor #8080ff}
  22.     {-foreground foreground Foreground black}
  23.     {-text text Text ""}
  24.     {-value value Value 0}
  25.     }
  26.     -default {
  27.     {.relief        sunken}
  28.     {.borderWidth        2}
  29.     {.width            150}
  30.     }
  31. }
  32.  
  33. proc tixMeter:InitWidgetRec {w} {
  34.     upvar #0 $w data
  35.     global env
  36.  
  37.     tixChainMethod $w InitWidgetRec
  38. }
  39.  
  40. #----------------------------------------------------------------------
  41. #        Construct widget
  42. #----------------------------------------------------------------------
  43. proc tixMeter:ConstructWidget {w} {
  44.     upvar #0 $w data
  45.  
  46.     tixChainMethod $w ConstructWidget
  47.  
  48.     set data(w:canvas) [canvas $w.canvas]
  49.     pack $data(w:canvas) -expand yes -fill both
  50.  
  51.     tixMeter:Update $w
  52. }
  53.  
  54. proc tixMeter:SetBindings {w} {
  55.     upvar #0 $w data
  56.  
  57.     tixChainMethod $w SetBindings
  58. }
  59.  
  60. proc tixMeter:Update {w} {
  61.     upvar #0 $w data
  62.  
  63.     # set the width of the canvas
  64.     set W [expr $data(-width)-\
  65.     ([$data(w:root) cget -bd]+[$data(w:root) cget -highlightthickness]*2)]
  66.     $data(w:canvas) config -width $W
  67.  
  68.     if {$data(-text) == ""} {
  69.     set text [format "%d%%" [expr int($data(-value)*100)]]
  70.     } else {
  71.     set text $data(-text)
  72.     }
  73.  
  74.     # (Create/Modify) the text item.
  75.     #
  76.     if {![info exists data(text)]} {
  77.     set data(text) [$data(w:canvas) create text 0 0 -text $text]
  78.     } else {
  79.     $data(w:canvas) itemconfig $data(text) -text $text
  80.     }
  81.  
  82.     set bbox [$data(w:canvas) bbox $data(text)]
  83.  
  84.     set itemW [expr [lindex $bbox 2]-[lindex $bbox 0]]
  85.     set itemH [expr [lindex $bbox 3]-[lindex $bbox 1]]
  86.  
  87.  
  88.     $data(w:canvas) coord $data(text) [expr $W/2] [expr $itemH/2+4]
  89.  
  90.     set H [expr $itemH + 4]
  91.     $data(w:canvas) config -height [expr $H]
  92.  
  93.  
  94.     set rectW [expr int($W*$data(-value))]
  95.  
  96.     if {![info exists data(rect)]} {
  97.     set data(rect) [$data(w:canvas) create rectangle 0 0 $rectW 1000]
  98.     } else {
  99.     $data(w:canvas) coord $data(rect) 0 0 $rectW 1000
  100.     }
  101.  
  102.     $data(w:canvas) itemconfig $data(rect) \
  103.     -fill $data(-fillcolor) -outline $data(-fillcolor)
  104.  
  105.     $data(w:canvas) raise $data(text)
  106. }
  107.  
  108. #----------------------------------------------------------------------
  109. # Configuration
  110. #----------------------------------------------------------------------
  111. proc tixMeter:config-value {w value} {
  112.     upvar #0 $w data
  113.  
  114.     set data(-value) $value
  115.     tixMeter:Update $w
  116. }
  117.  
  118. proc tixMeter:config-text {w value} {
  119.     upvar #0 $w data
  120.  
  121.     set data(-text) $value
  122.     tixMeter:Update $w
  123. }
  124.  
  125.